#include <tcl.h>

#include "f_core.h"
#include "f_bool.h"

#include "debug.h"

int
T_ObjCmd(ClientData data,Tcl_Interp *interp,int objc,Tcl_Obj *const objv[])
{
    int yes;
    if (objc==1) {
        if (data==NULL)
            Tcl_SetObjResult(interp,Tcl_NewBooleanObj(1));
        else
            Tcl_SetObjResult(interp,Tcl_NewBooleanObj(0));
        return TCL_OK;
    }
    if (objc==2) {
        if (Tcl_GetBooleanFromObj(interp,objv[1],&yes)!=TCL_OK) {
            Tcl_SetResult(interp,"unable convert to boolean",NULL);
            return TCL_ERROR;
        }
        if (data!=NULL) yes=!yes;
        if (yes) {
            Tcl_SetObjResult(interp,objv[1]);
        } else {
            Tcl_SetObjResult(interp,tupleObjNew());
        }
        return TCL_OK;
    }
    int code;
    Tcl_Obj *result;
    code=Tcl_EvalObjv(interp,objc-1,objv+1,0);
    if (code!=TCL_OK && code!=TCL_RETURN) {
        Tcl_SetResult(interp,"error in test expression",NULL);
        return TCL_ERROR;
    }
    result=Tcl_GetObjResult(interp);
    if (Tcl_GetBooleanFromObj(interp,result,&yes)!=TCL_OK) {
            Tcl_SetResult(interp,"unable convert expression result to boolean",NULL);
            return TCL_ERROR;
    }
    if (data!=NULL) yes=!yes;
    if (yes) {
        Tcl_SetObjResult(interp,objv[objc-1]);
    } else {
        Tcl_SetObjResult(interp,tupleObjNew());
    }
    return TCL_OK;
}

int
tupleEqual(Tcl_Interp *interp,Tcl_Obj *tuple1,Tcl_Obj *tuple2)
{
    SHOULD(tuple1!=NULL, return 0);
    SHOULD(tuple2!=NULL, return 0);
    
    if (tuple1->typePtr==lazyType) {
        lazyObjExec(tuple1,1);
    }
    SHOULD(tuple1->typePtr==tupleType || Tcl_ConvertToType(interp,tuple1,tupleType)==TCL_OK,return 0);
    
    if (tuple2->typePtr==lazyType) {
        lazyObjExec(tuple2,1);
    }
    SHOULD(tuple2->typePtr==tupleType || Tcl_ConvertToType(interp,tuple2,tupleType)==TCL_OK,return 0);
    
    Cons *cons1,*cons2;
    for(cons1=tupleFirstCons(interp,tuple1),cons2=tupleFirstCons(interp,tuple2);
        cons1!=NULL && cons2!=NULL;
        cons1=tupleNextCons(interp,tuple1,cons1),cons2=tupleNextCons(interp,tuple2,cons2)) {
        // попробовать сравнить lazy не исполняя
        if (cons1->obj->typePtr==lazyType && cons2->obj->typePtr==lazyType) {
            if (lazyEqual(interp,cons1->obj,cons2->obj)) continue;
        }
        // придётся исполнять lazy
        if (cons1->obj->typePtr==lazyType) {
            lazyObjExec(cons1->obj,1);
        }
        if (cons2->obj->typePtr==lazyType) {
            lazyObjExec(cons2->obj,1);
        }
        // сравнивать по-элементно
        if (!objEqual(interp,cons1->obj,cons2->obj)) return 0;
    }
    // если __все__ значимые эл-ты совпали - объекты эквивалентны
    if (cons1==NULL && cons2==NULL)
        return 1;
    return 0;
}

int
listEqual(Tcl_Interp *interp,Tcl_Obj *list1,Tcl_Obj *list2)
{
    SHOULD(list1!=NULL,return 0);
    SHOULD(list2!=NULL,return 0);
    if (list1==list2) return 1;
    SHOULD(list1->typePtr==listType || Tcl_ConvertToType(interp,list1,listType)==TCL_OK,return 0);
    SHOULD(list2->typePtr==listType || Tcl_ConvertToType(interp,list2,listType)==TCL_OK,return 0);
    int list1_objc;
    Tcl_Obj **list1_objv;
    int list2_objc;
    Tcl_Obj **list2_objv;
    if (Tcl_ListObjGetElements(interp,list1,&list1_objc,&list1_objv)!=TCL_OK) {
        ERR("no access to list1 elements");
        return 0;
    }
    if (Tcl_ListObjGetElements(interp,list2,&list2_objc,&list2_objv)!=TCL_OK) {
        ERR("no access to list1 elements");
        return 0;
    }
    if (list1_objc!=list2_objc)
        return 0;
    int c;
    for(c=0;c<list1_objc;c++) {
        if (!objEqual(interp,list1_objv[c],list2_objv[c])) return 0;
    }
    return 1;
}
int
lazyEqual(Tcl_Interp *interp,Tcl_Obj *lazy1,Tcl_Obj *lazy2)
{
    SHOULD(lazy1!=NULL,return 0);
    SHOULD(lazy2!=NULL,return 0);
    SHOULD(lazy1->typePtr==lazyType && lazy2->typePtr==lazyType,return 0);
    if (LAZY(lazy1)->dirty!=NULL || LAZY(lazy2)->dirty!=NULL) return 0;
    if (!objEqual(interp,LAZY(lazy1)->cmd,LAZY(lazy2)->cmd)) return 0;
    return 1;
}

int
objEqual(Tcl_Interp *interp,Tcl_Obj *obj1,Tcl_Obj *obj2)
{
    SHOULD(obj1!=NULL,return 0);
    SHOULD(obj2!=NULL,return 0);
    if (obj1==obj2) return 1;
    if (obj1->typePtr==lazyType && obj2->typePtr==lazyType && lazyEqual(interp,obj1,obj2)) return 1;
    if (obj1->typePtr==lazyType) {
        lazyObjExec(obj1,1);
    }
    if (obj2->typePtr==lazyType) {
        lazyObjExec(obj2,1);
    }
    if (obj1->typePtr==tupleType || obj2->typePtr==tupleType) return tupleEqual(interp,obj1,obj2);
    if ((obj1->bytes!=NULL && obj2->bytes!=NULL) || obj1->typePtr==NULL || obj2->typePtr==NULL) {
        Tcl_Obj *cmd[3];
        int code;
        int yes;
        Tcl_Obj *result;
        cmd[0]=Tcl_NewStringObj("::tcl::mathops::==",-1);
        cmd[1]=obj1;
        cmd[2]=obj2;
        code=Tcl_EvalObjv(interp,3,cmd,0);
        if (code!=TCL_OK) return 0;
        result=Tcl_GetObjResult(interp);
        if (Tcl_GetBooleanFromObj(interp,result,&yes)!=TCL_OK) return 0;
        if (!yes) return 0;
    }
    return listEqual(interp,obj1,obj2);
}
